VB 加油站
A 入门技巧
B API
C 用户界面
D 网络
E 控件
F 文件系统
H 多媒体
I 数据库
J 程序应用
K 外设
Z 其他
下载区域
技术文档
原创空间
写留言
看留言
VB讨论
友情连接
回到首页
Win加油站
C 用户界面
B 窗口
016 拖动没有标题的窗体 98-11-19
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As
Single)
If Button = 1 Then
Dim ReturnVal As Long
x = ReleaseCapture()
ReturnVal = SendMessage(hwnd, WM_NCLBUTTONDOWN,
HTCAPTION, 0)
End If
End Sub
015 任意多边形的窗口 98-10-20
声明：
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim XY() As POINTAPI
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
该例子把窗口变成了一个 T 型：
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Command1_Click()
Dim hRgn As Long
Dim lRes As Long
ReDim XY(7) As POINTAPI 'T 形需要 8 个点
With Me
XY(0).X = 0
XY(0).Y = 0
XY(1).X = .ScaleWidth
XY(1).Y = 0
XY(2).X = .ScaleWidth
XY(2).Y = .ScaleHeight / 2
XY(3).X = .ScaleWidth - (.ScaleWidth / 3)
XY(3).Y = .ScaleHeight / 2
XY(4).X = .ScaleWidth - (.ScaleWidth / 3)
XY(4).Y = .ScaleHeight
XY(5).X = .ScaleWidth / 3
XY(5).Y = .ScaleHeight
XY(6).X = .ScaleWidth / 3
XY(6).Y = .ScaleHeight / 2
XY(7).X = 0
XY(7).Y = .ScaleHeight / 2
End With
hRgn = CreatePolygonRgn(XY(0), 8, 2)
lRes = SetWindowRgn(Me.hWnd, hRgn, True)
End Sub
014 用Api 打开About 窗口 98-10-07
声明：
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" _
(ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, _
ByVal hIcon As Long) As Long
使用：
Private Sub Command1_Click()
Call ShellAbout(hWnd, "一个微软的 About 窗口!", _
"欢迎您的使用！" _
& vbCrLf & "OK,OK,OK,OK，", Me.Icon)
End Sub
013 运行中隐藏/显示窗口标题栏 98-9-28
声明：
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Enum ESetWindowPosStyles
SWP_SHOWWINDOW = &H40
SWP_HIDEWINDOW = &H80
SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200 ' Don't do owner Z ordering
SWP_NOREDRAW = &H8
SWP_NOREPOSITION = SWP_NOOWNERZORDER
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_DRAWFRAME = SWP_FRAMECHANGED
HWND_NOTOPMOST = -2
End Enum
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Function ShowTitleBar(ByVal bState As Boolean)
Dim lStyle As Long
Dim tR As RECT
GetWindowRect Me.hwnd, tR
lStyle = GetWindowLong(Me.hwnd, GWL_STYLE)
If (bState) Then
Me.Caption = Me.Tag
If Me.ControlBox Then
lStyle = lStyle Or WS_SYSMENU
End If
If Me.MaxButton Then
lStyle = lStyle Or WS_MAXIMIZEBOX
End If
If Me.MinButton Then
lStyle = lStyle Or WS_MINIMIZEBOX
End If
If Me.Caption <> "" Then
lStyle = lStyle Or WS_CAPTION
End If
Else
Me.Tag = Me.Caption
Me.Caption = ""
lStyle = lStyle And Not WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle And Not WS_CAPTION
End If
SetWindowLong Me.hwnd, GWL_STYLE, lStyle
' 保证窗口具有相同的大小
' 注意这时看见区域已经不同！
SetWindowPos Me.hwnd, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
Me.Refresh
' 看见区域已经不同后应该发生 RESIZE 事件
Form_Resize
End Function
使用：
'显示： ShowTitleBar True
'隐藏： ShowTitleBar False
012 保持初始的窗体大小 98-9-21
感谢 p-j 提供。
先在声明中加入
Dim myheight, mywidth As Integer
在窗体的LOAD事件中加入
mywidth = Me.Width
myheight = Me.Height
在Resize事件中加入
Me.Height = myheight
Me.Width = mywidth
011 让最大化和最小化按钮消失 98-9-12
声明：
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long) As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
使用：
Private Sub Form_Load()
Dim lWnd As Long
lWnd = GetWindowLong(Me.hwnd, GWL_STYLE)
lWnd = lWnd And Not (WS_MINIMIZEBOX)
lWnd = lWnd And Not (WS_MAXIMIZEBOX)
lWnd = SetWindowLong(Me.hwnd, GWL_STYLE, lWnd)
End Sub
010 暂时禁止窗口更新 98-9-11
这里介绍的 API 可以暂时锁定窗口的显示， 禁止重画窗口。 在更新好窗口中的内容后， 再把它显示出来：
声明：
Declare Function LockWindowUpdate Lib "user32" Alias "LockWindowUpdate" (ByVal hwndLock As Long) As Long
使用：
' 禁止重画
LockWindowUpdate Me.hWnd
' 执行更新窗口内容的语句
....
'显示更新后的窗口
LockWindowUpdate 0
009 使关闭、最大、最小化不可用 98-8-22
声明：
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Const MF_BYPOSITION = &H400&
Public Const MF_REMOVE = &H1000&
使用：
Private Sub Form_Load()
Dim hSysMenu As Long
Dim nCnt As Long
Me.Show
hSysMenu = GetSystemMenu(Me.hwnd, False)
If hSysMenu Then
' 取得系统菜单中的数量
nCnt = GetMenuItemCount(hSysMenu)
If nCnt Then
' 编号 (0, 1, 2, 3...)
RemoveMenu hSysMenu, nCnt - 1, MF_BYPOSITION Or MF_REMOVE
'去掉 关闭 按钮
RemoveMenu hSysMenu, nCnt - 2, MF_BYPOSITION Or MF_REMOVE
' 去掉一个下划线
'注意下面的语句， 请根据不同 Form 类别具体情况进行调试，
' 没个语句将关闭不同的功能！！
'RemoveMenu hSysMenu, nCnt - 3, MF_BYPOSITION Or MF_REMOVE
'RemoveMenu hSysMenu, nCnt - 4, MF_BYPOSITION Or MF_REMOVE
'RemoveMenu hSysMenu, nCnt - 5, MF_BYPOSITION Or MF_REMOVE
DrawMenuBar Me.hwnd
' 重画
End If
End If
End Sub
98-9-09 更新： 感谢 提供的方法二：
Const MF_REMOVE = &H1000&
Const SC_CLOSE = &HF060
Const SC_MAXIMIZE = &HF030
并在 Sub Form_Load()中加入：
RemoveMenu GetSystemMenu(hwnd, 0), SC_CLOSE, MF_REMOVE
这样就可以使关闭按钮无效。同样加入
RemoveMenu GetSystemMenu(hwnd, 0), SC_MAXIMIZE, MF_REMOVE
008 禁止使用 Alt+F4 关闭窗口 98-8-21
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
End Sub
007 窗口事件的发生顺序 98-8-03
1 Form_Initialize
2 Form_Load
3 Form_Resize
4 Form_Activate
5 Form_GotFocus
6 Form_Paint
7 Form_Unload
8 Form_Terminate
006 一闪而过的应用启动窗口 98-7-15
类似于 VB 的一闪而过的应用启动窗口，利用以下的方法实现：
1 在应用启动窗口中使用 Timer，例如记数到 2 秒时，自动关闭窗口。
2 在主程序启动时，先 Show 应用启动窗口（不要用参数)。设置应用启动窗口保持在最前面。继续其他的工作。
005 在 Unload Me 后面的语句可能引起 Form 行为异常 98-7-13
一个偶然的机会，我在 Command1 的 Click 中使用了以下的语句：
if Command1.caption = "a" then
...
unload me
end if
if Command1.caption = "b" then
....
end if
结果在Command1 为 a 时，我的 Form_Load 里的变量不能正确初始化，调试的结果是在执行了 unload me 后，在 if Command1.caption = "b" then 时，Form 又被Load 了，执行了 Form_Load。而在下次 Form.Show 时，不再执行 Form_Load 。
所以，好的方法是不要在 unload me 后执行其他语句。
004 透明的窗口 98-7-04
声明：
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const WS_EX_TRANSPARENT = &H20&
Const GWL_EXSTYLE = (-20)
使用：
retval = SetWindowLong(Form2.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT)
透明效果是出来啦，如果移动的话，屏幕会变乱。
003 使窗口保持在最前面
Declare Function SetWindowPos Lib "user32" ( ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
public sub SetFormOnTop(myForm as object)
SetWindowPos myForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE
end sub
002 制作窗口背景
现有图片 Picture， 用以下的方法，将该图片布满整个窗口：
For I = 0 To ScaleWidth \ Picture.Width
For J = 0 To ScaleHeight \ Picture.Height
PaintPicture Picture, I * Picture.Width, J * Picture.Height
Next
Next
001 创建不规则窗口
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Load()
Show
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 200), True
End Sub
上述代码可以创建一个椭圆形状的窗口。
